home *** CD-ROM | disk | FTP | other *** search
/ Amiga Tools 2 / Amiga Tools 2.iso / tools / jade / lisp / help.jl < prev    next >
Lisp/Scheme  |  1995-03-09  |  7KB  |  232 lines
  1. ;;;; help.jl -- Online help system
  2. ;;;  Copyright (C) 1993, 1994 John Harper <jsh@ukc.ac.uk>
  3.  
  4. ;;; This file is part of Jade.
  5.  
  6. ;;; Jade is free software; you can redistribute it and/or modify it
  7. ;;; under the terms of the GNU General Public License as published by
  8. ;;; the Free Software Foundation; either version 2, or (at your option)
  9. ;;; any later version.
  10.  
  11. ;;; Jade is distributed in the hope that it will be useful, but
  12. ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;;; GNU General Public License for more details.
  15.  
  16. ;;; You should have received a copy of the GNU General Public License
  17. ;;; along with Jade; see the file COPYING.  If not, write to
  18. ;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (provide 'help)
  21.  
  22. (defvar help-buffer (make-buffer "*Help*"))
  23. (set-buffer-special help-buffer t)
  24.  
  25. (defvar help-keymap (make-keylist))
  26. (bind-keys help-keymap
  27.   "SPC" 'next-screen
  28.   "BS" 'prev-screen
  29.   "q" 'bury-buffer)
  30.  
  31. (defvar help-prompt-keymap (make-keylist))
  32. (bind-keys help-prompt-keymap
  33.   "a" 'apropos-function
  34.   "b" 'describe-keymap
  35.   "e" 'apropos-variable
  36.   "f" 'describe-function
  37.   "h" 'help-help
  38.   "Ctrl-h" 'help-help
  39.   "i" 'info
  40.   "Ctrl-i" '(info t)
  41.   "k" 'describe-key
  42.   "m" 'describe-mode
  43.   "?" 'help-help
  44.   "v" 'describe-variable
  45.   "SPC" '(progn (next-screen) (help))
  46.   "BS" '(progn (prev-screen) (help)))
  47.  
  48. (with-buffer help-buffer
  49.   (setq keymap-path '(help-keymap global-keymap)
  50.     mode-name "Help"
  51.     buffer-record-undo nil))
  52.  
  53. ;;;###autoload
  54. (defun help ()
  55.   "Entrance to the online-help system."
  56.   (interactive)
  57.   (message "Type: a b f h i k m v -- h for more help")
  58.   (setq next-keymap-path '(help-prompt-keymap)))
  59.  
  60. (defun help-help ()
  61.   "Displays some text describing the options in the help system."
  62.   (interactive)
  63.   (clear-buffer help-buffer)
  64.   (insert
  65.     "\nHelp mode -- Type one of the following:\n
  66. a   `apropos-function'
  67.     Search for functions which match a regular expression.
  68.  
  69. b   `describe-keymap'
  70.     Print the key bindings which are currently active.
  71.  
  72. f   `describe-function'
  73.     View the documentation for a particular function.
  74.  
  75. h   `help-help'
  76.     Display this text.
  77.  
  78. i   `info'
  79.     Enter the info hypertext viewer.
  80.  
  81. k   `describe-key'
  82.     Display the command (and its documentation) that a particular
  83.     sequence of keys is currently bound to.
  84.  
  85. m   `describe-mode'
  86.     Show the documentation for the edit mode of the current buffer.
  87.  
  88. v   `describe-variable'
  89.     View the documentation and value of a variable."
  90.     (buffer-start) help-buffer)
  91.     (goto-buffer help-buffer)
  92.     (goto-buffer-start)
  93.     (help))
  94.  
  95. ;; Setup the help-buffer for insertion of the help text
  96. (defun help-setup ()
  97.   (clear-buffer help-buffer)
  98.   (goto-buffer help-buffer)
  99.   (insert "\n----\nType `q' to return to the buffer you were in.")
  100.   (goto-buffer-start))
  101.  
  102. (defun apropos-function (regexp)
  103.   (interactive "sRegular expression:")
  104.   (help-setup)
  105.   (format help-buffer "Apropos for expression %S:\n" regexp)
  106.   (print (apropos regexp 'fboundp) help-buffer)
  107.   (goto-buffer-start))
  108.  
  109. (defun apropos-variable (regexp)
  110.   (interactive "sRegular expression:")
  111.   (help-setup)
  112.   (format help-buffer "Apropos for expression %S:\n" regexp)
  113.   (print (apropos regexp 'boundp) help-buffer)
  114.   (goto-buffer-start))
  115.  
  116. (defun describe-keymap ()
  117.   "Print the full contents of the current keymap (and the keymaps that
  118. it leads to)."
  119.   (interactive)
  120.   (let
  121.       ((old-buf (current-buffer))
  122.        (km-list keymap-path))
  123.     (help-setup)
  124.     (print-keymap km-list old-buf)
  125.     (goto-buffer-start)))
  126.  
  127. (defun describe-function (fun &aux doc)
  128.   "Display the documentation of a function, macro or special-form."
  129.   (interactive "aDescribe function:")
  130.   (setq doc (documentation fun))
  131.   (help-setup)
  132.   (let*
  133.       ((fval (symbol-function fun))
  134.        (type (cond
  135.           ((special-form-p fval)
  136.            "Special Form")
  137.           ((subrp fval)
  138.            "Built-in Function")
  139.           ((eq (car fval) 'macro)
  140.            "Macro")
  141.           (t
  142.            "Function"))))
  143.     (when (consp fval)
  144.       ;; Check if it's been compiled.
  145.       (when (assq 'jade-byte-code fval)
  146.     ;; compiled forms
  147.     (setq type (concat "Compiled " type))))
  148.     (format help-buffer "\n%s: %s\n\n" type fun)
  149.     (when (fboundp fun)
  150.       (unless (subrp fval)
  151.     ;; A Lisp function or macro, print its argument spec.
  152.     (let
  153.         ((lambda-list (nth (if (eq (car fval) 'macro) 2 1) fval)))
  154.       (prin1 fun help-buffer)
  155.       (when (eq (car lambda-list) 'lambda)
  156.         ;; A macro
  157.         (setq lambda-list (cdr lambda-list)))
  158.       ;; Print the arg list (one at a time)
  159.       (while lambda-list
  160.         (let
  161.         ((arg-name (symbol-name (car lambda-list))))
  162.           ;; Unless the argument starts with a `&' print it in capitals
  163.           (unless (= (aref arg-name 0) ?&)
  164.         (setq arg-name (translate-string (copy-sequence arg-name)
  165.                          upcase-table)))
  166.           (format help-buffer " %s" arg-name))
  167.         (setq lambda-list (cdr lambda-list)))
  168.       (insert "\n\n")))))
  169.   (insert (or doc "Undocumented."))
  170.   (insert "\n")
  171.   (goto-buffer-start))
  172.  
  173. (defun describe-variable (var)
  174.   (interactive "vDescribe variable:")
  175.   (let
  176.       ((doc (documentation var t))
  177.        (old-buf (current-buffer)))
  178.     (help-setup)
  179.     (format help-buffer
  180.         "\n%s: %s\nCurrent value: %S\n\n%s\n"
  181.         (if (const-variable-p var)
  182.         "Constant"
  183.           "Variable")
  184.         (symbol-name var)
  185.         (with-buffer old-buf (symbol-value var t))
  186.         (or doc "Undocumented."))
  187.       (goto-buffer-start)))
  188.  
  189. ;;;###autoload
  190. (defun describe-mode ()
  191.   "Print the help text for the current editing mode."
  192.   (interactive)
  193.   (let
  194.       ((mode major-mode))
  195.     (help-setup)
  196.     (let
  197.         ((doc (documentation mode)))
  198.       (when (stringp doc)
  199.     (format help-buffer "\n%s\n" doc)
  200.     (goto-buffer-start)))))
  201.  
  202. ;;;###autoload
  203. (defun documentation (symbol &optional is-variable)
  204.   "Returns the documentation-string for SYMBOL. If IS-VARIABLE is t the
  205. documentation for the variable stored in SYMBOL is returned, else
  206. the function doc is provided."
  207.   (when (symbolp symbol)
  208.     (let
  209.     (doc)
  210.       (if is-variable
  211.       (setq doc (get symbol 'variable-documentation))
  212.     (when (eq (car (symbol-function symbol)) 'autoload)
  213.       (load (nth 1 (symbol-function symbol))))
  214.     (setq symbol (symbol-function symbol))
  215.     (cond
  216.      ((subrp symbol)
  217.       (setq doc (subr-documentation symbol)))
  218.      ((or (eq 'macro (car symbol)) (eq 'special (car symbol)))
  219.       (setq doc (nth 3 symbol)))
  220.      (t
  221.       (setq doc (nth 2 symbol)))))
  222.       (when (numberp doc)
  223.     (setq doc (get-doc-string doc)))
  224.       (when (stringp doc)
  225.     doc))))
  226.  
  227. ;;;###autoload
  228. (defun document-var (symbol doc-string)
  229.   "Sets the `variable-documentation' property of SYMBOL to DOC-STRING."
  230.   (put symbol 'variable-documentation doc-string)
  231.   symbol)
  232.